home *** CD-ROM | disk | FTP | other *** search
/ PC Open 105 / PC Open 105 CD 1.bin / CD1 / INTERNET / COPIA SITI / Getleft / getleft-setup-notcl.exe / {app} / scripts / Dialogos.tcl < prev    next >
Encoding:
Text File  |  2004-05-07  |  14.0 KB  |  422 lines
  1. ###############################################################################
  2. ###############################################################################
  3. #####                            Dialogos.tcl
  4. ###############################################################################
  5. ###############################################################################
  6. ##### The contents of this file are adapted from an example in Brent Welch's
  7. ##### book "Practical Programming in Tcl/Tk". I made the changes without
  8. ##### knowing very well what I was doing, so please, don't blame him for all
  9. ##### the weirdness.
  10. ###############################################################################
  11. ##### Copyright 1999-2003 Brent Welch - AndrΘs Garcφa.  fandom@retemail.es
  12. ##### The contents of this file are distributed under the terms of the LGPL
  13. ###############################################################################
  14.  
  15. namespace eval Dialogos {
  16.  
  17. ###############################################################################
  18. # SelectDirNative
  19. #     Does the work by using a Windows dialog
  20. #
  21. # Parameters:
  22. #     initialDir: The directory in which the dialog will open itself.
  23. #     parent: The window over which it will appear.
  24. #
  25. # Returns:
  26. #     The chosen path or an empty string if the user cancels.
  27. #
  28. # Side effects:
  29. #     If you select a non-existing directory, it will be created for you.
  30. ###############################################################################
  31. proc SelectDirNative {initialDir parent} {
  32.     global labelTitles labelMessages indexButtons
  33.  
  34.     set chosenDir [tk_chooseDirectory -title $labelTitles(directory)         \
  35.             -parent $parent -initialdir $initialDir]
  36.  
  37.     if {$chosenDir==""} return
  38.  
  39.     if {![file exist $chosenDir]} {
  40.         set what [tk_messageBox -icon question \
  41.                 -message $labelMessages(unknown) -title $labelTitles(unknown)\
  42.                 -parent $parent -type yesno]
  43.         if {$what=="no"} {
  44.             set initialDir $chosenDir
  45.             while {![file exists $initialDir]} {
  46.                 set initialDir [file dirname $initialDir]
  47.             }
  48.             return [SelectDirWindows $initialDir $parent]
  49.         }
  50.         file mkdir $chosenDir
  51.     }
  52.     return $chosenDir
  53. }
  54.  
  55. ###############################################################################
  56. # SelectDirectory
  57. #    Opens a dialog window which allows the user to choose one directory. If
  58. #    needed, the directory is created.
  59. #
  60. # Parameter:
  61. #    initialDir: directory where the dialog should open itself.
  62. #    parent: the parent window of the dialog, it defaults to the main
  63. #    window of the app.
  64. #
  65. # Returns
  66. #    The full path of the chosen directory.
  67. ###############################################################################
  68. proc SelectDirectory {{initialDir {} } {parent {.} } } {
  69.     variable fileselect
  70.     variable useWinDialog
  71.     global tcl_patchLevel getleftState
  72.     global dirGetleft getleftOptions labelMenus indexButtons
  73.     global env labelButtons labelTitles labelDialogs labelMessages
  74.  
  75.     set useNativeDialog 0
  76.     if {$getleftState(os)!="unix"} {
  77.         set useNativeDialog 1
  78.     }
  79.     if {$useNativeDialog==1} {
  80.         return [SelectDirNative $initialDir $parent]
  81.     }
  82.  
  83.     catch {destroy .fileselect}
  84.     set t [toplevel .fileselect -bd 4]
  85.  
  86.     set coord(x) [winfo rootx $parent]
  87.     set coord(y) [winfo rooty $parent]
  88.  
  89.     wm title $t $labelTitles(directory)
  90.     wm resizable $t 0 0
  91.     wm geometry $t +[expr {$coord(x)+100}]+[expr {$coord(y)+15}]
  92.  
  93.     set fdir [frame $t.directorio]
  94.     set imaArr [image create photo \
  95.             -file [file join "$dirGetleft(icons)" arriba.gif]]
  96.     set imaNew [image create photo \
  97.             -file [file join "$dirGetleft(icons)" nuevo.gif]]
  98.     button $fdir.arriba -image $imaArr -command {
  99.         Dialogos::fileselectList [file dirname $Dialogos::fileselect(dir)]
  100.         Dialogos::fileselectOK
  101.     }
  102.     button $fdir.new    -image $imaNew -command ::Dialogos::NewDir
  103.  
  104.     BalloonHelp::set_balloon $fdir.arriba $labelMessages(up)
  105.     BalloonHelp::set_balloon $fdir.new    $labelMessages(newDir)
  106.  
  107.     # Entrada de solo lectura para el directorio actual.
  108.     set ldir [label $fdir.label -text "$labelDialogs(current): "]
  109.     set fileselect(dirEnt) [label $fdir.entry -relief sunken -width 35 \
  110.         -bg $getleftOptions(bg) -fg $getleftOptions(fg) -anchor w]
  111.     pack $ldir $fdir.entry -side left
  112.     pack $fdir.arriba $fdir.new -side left -padx 5
  113.     pack $fdir -side top -fill x -pady 5
  114.  
  115.     # listbox para ver el contenido del directorio.
  116.  
  117.     set lista [frame $t.lista]
  118.     listbox $lista.list -yscrollcommand [list $lista.scroll set] \
  119.             -bg $getleftOptions(bg) -fg $getleftOptions(fg) -height 10
  120.     scrollbar $lista.scroll -command [list $lista.list yview]
  121.     pack $lista.list -side left -fill x -expand true -padx 3
  122.     pack $lista.scroll -side left -fill y
  123.     pack $lista -side top -fill x -expand true -pady 3
  124.  
  125.     # entry para el nombre del fichero a cargar
  126.     # el valor se guarda en fileselect(path)
  127.     frame $t.top
  128.     label $t.top.l -text "$labelDialogs(dir): " -padx 0
  129.     set e [menuEntry::menuEntry $t.top.path -relief sunken           \
  130.            -fg $getleftOptions(fg) -width 27 -bg $getleftOptions(bg) \
  131.            -textvariable Dialogos::fileselect(path)]
  132.     pack $t.top -side top -fill x
  133.     pack $t.top.l -side left
  134.     pack $t.top.path -side left
  135.     set fileselect(pathEnt) $e
  136.  
  137.     # Set up bindings to invoke OK and Cancel
  138.     bind $e <Return> {
  139.         if {[Dialogos::fileselectOK]==1} {
  140.             set Dialogos::fileselect(done) 1
  141.         }
  142.     }
  143.     bind $e <Control-c> Dialogos::fileselectCancel
  144.     focus $e
  145.  
  146.     #Botones de Abrir y cancelar
  147.  
  148.     underButton::UnderButton $t.top.ok -buttontype button -width 10           \
  149.             -textvariable labelButtons(select) -under $indexButtons(select)   \
  150.             -command {
  151.                 if {[Dialogos::fileselectOK]==1} {
  152.                 set Dialogos::fileselect(done) 1
  153.             }
  154.     }
  155.     pack $t.top.ok -side right
  156.  
  157.     frame $t.cancel
  158.     underButton::UnderButton $t.cancel.cancelar -buttontype button -width 10  \
  159.             -textvariable labelButtons(cancel)  -under $indexButtons(cancel)  \
  160.             -command {set Dialogos::fileselect(done) 0}
  161.     pack $t.cancel.cancelar -side right
  162.     pack $t.cancel -side bottom -fill x
  163.     wm protocol $t WM_DELETE_WINDOW "$t.cancel.cancelar invoke"
  164.  
  165.     # A single click to listbox so the user can use arrow keys
  166.     bind $e <Tab> "focus $t.lista.list ; list select set 0 ; break"
  167.     bind $t.lista.list      <Return>         "Dialogos::fileselectTmp ; break"
  168.     bind $t.lista.list      <KP_Enter>       "Dialogos::fileselectTmp ; break"
  169.     bind $t.lista.list         <space>          "Dialogos::fileselectTake ; break"
  170.     bind $t.lista.list      <Tab>            "focus $t.top.ok ; break"
  171.     bind $t.lista.list      <Button-1>        {focus %W}
  172.     bind $t.lista.list      <Double-Button-1> {Dialogos::fileselectTmp ; break }
  173.     bind $t                <KeyPress-Prior> "$lista.list yview scroll -1 pages;break"
  174.     bind $t                <KeyPress-Next>  "$lista.list yview scroll  1 pages;break"
  175.     bind $t.top.ok          <Tab>            "focus $t.cancel.cancelar ; break"
  176.     bind $t.cancel.cancelar <Tab>            "focus $e ; break"
  177.     bind $t                 <Escape>         "$t.cancel.cancelar invoke"
  178.  
  179.     # Inicializar las variables
  180.  
  181.     set fileselect(path) {}
  182.     if {($initialDir!="")&&([file exists $initialDir])} {
  183.         set dir $initialDir
  184.     } else {
  185.         set dir $env(HOME)
  186.     }
  187.  
  188.     set fileselect(dir) {}
  189.     set fileselect(done) 0
  190.  
  191.     # Wait for the listbox to be visible so
  192.     # we can provide feedback during the listing
  193.     tkwait visibility .fileselect.lista.list
  194.     fileselectList $dir
  195.  
  196.     grab .fileselect
  197.     tkwait variable Dialogos::fileselect(done)
  198.     grab release .fileselect
  199.  
  200.     destroy .fileselect
  201.     update     
  202.     if {$fileselect(done)==1} {
  203.         return $fileselect(path)
  204.     }
  205.     return
  206. }
  207.  
  208. ###############################################################################
  209. # NewDir
  210. #    Opens a dialog box to create a new directory.
  211. ###############################################################################
  212. proc NewDir {} {
  213.     variable fileselect
  214.     global labelTitles labelButtons getleftOptions
  215.     variable done
  216.  
  217.     set coord(x) [winfo rootx .fileselect]
  218.     set coord(y) [winfo rooty .fileselect]
  219.  
  220.     set dialog  [toplevel .dialog]
  221.     wm title $dialog $labelTitles(newDir)
  222.     wm resizable $dialog 0 0
  223.     wm geometry  $dialog +[expr {$coord(x)+100}]+[expr {$coord(y)+15}]
  224.  
  225.     set done 0
  226.  
  227.     set marcoEx [frame $dialog.marcoEx]
  228.     set marco   [frame $marcoEx.marco -bd 2 -relief groove]
  229.     set marcoIn [frame $marco.marcoIn]
  230.     set dirEnt  [entry $marcoIn.dirent -relief sunken -fg $getleftOptions(fg) \
  231.             -bg $getleftOptions(bg) -width 25]
  232.  
  233.     set botones  [frame  $dialog.botones]
  234.     set aceptar  [button $botones.aceptar  -textvariable labelButtons(ok)     \
  235.             -width 8 -command {set Dialogos::done 1}]
  236.     set cancelar [button $botones.cancelar -textvariable labelButtons(cancel) \
  237.             -width 8 -command {set Dialogos::done 0}]
  238.  
  239.     pack $cancelar -side right -padx 9 -pady 5
  240.     pack $aceptar  -side right -pady 5
  241.     pack $botones  -side bottom -fill x
  242.  
  243.     pack $dirEnt
  244.     pack $marcoIn -padx 10 -pady 10
  245.     pack $marco -side bottom
  246.     pack $marcoEx -ipadx 10 -ipady 5
  247.  
  248.     bind $dialog <Escape> "$cancelar invoke"
  249.     bind $dialog <Return> "$aceptar  invoke"
  250.  
  251.     focus $dirEnt
  252.     grab $dialog
  253.     tkwait variable Dialogos::done
  254.  
  255.     if {$done==1} {
  256.         set dir [$dirEnt get]
  257.         if {$dir!=""} {
  258.             if {[catch {file mkdir [file join $fileselect(dir) $dir]} error]} {
  259.                 tk_messageBox -title $labelTitles(error) -icon error \
  260.                         -message $error
  261.             } else {
  262.                 Dialogos::fileselectList $fileselect(dir)
  263.             }
  264.         }
  265.     }
  266.     grab release $dialog
  267.     destroy $dialog
  268.     return
  269. }
  270.  
  271. ###############################################################################
  272. # fileselectList
  273. #    Puts into the dialog box the directories found in the current one.
  274. #
  275. # Parameter
  276. #    dir: Current directory.
  277. ##############################################################################
  278. proc fileselectList {dir} {
  279.     variable fileselect
  280.  
  281.     # Update directory
  282.     $fileselect(dirEnt) configure -text [file nativename $dir]
  283.  
  284.     # Give the user some feedback
  285.     set fileselect(dir) $dir
  286.     .fileselect.lista.list delete 0 end
  287.     .fileselect.lista.list insert 0 Searching...
  288.     update idletasks
  289.  
  290.     .fileselect.lista.list delete 0
  291.  
  292.     # Add father directory and scan the current one
  293.     if {!([regexp {^((.:)?(/))$} $fileselect(dir)])} {
  294.         .fileselect.lista.list insert end ..
  295.     } else {
  296.        .fileselect.lista.list insert end /
  297.     }
  298.     set ficheros [glob -nocomplain $fileselect(dir)/*/]
  299.  
  300.    # Show results
  301.    foreach f [lsort -dictionary $ficheros] {
  302.        .fileselect.lista.list insert end [file tail $f]
  303.    }
  304.    return
  305. }
  306.  
  307. ###############################################################################
  308. # fileselectOk
  309. #    This procedure is invoked when a directory is selected, if needed it asks
  310. #    whether the user wants to create it.
  311. ##############################################################################
  312. proc fileselectOK { } {
  313.     variable fileselect
  314.     global labelTitles labelMessages
  315.  
  316.     if {$fileselect(path)==""} {
  317.         fileselectTake
  318.         if {$fileselect(path)==""} return 
  319.         if {[fileselectOK]==1} {
  320.           set fileselect(done) 1
  321.         }
  322.         return
  323.     }
  324.  
  325.    # El directorio padre tiene tratamiento especial
  326.     if {[regexp {\.\./?} $fileselect(path)]} {
  327.         set fileselect(path) {}
  328.         fileselectList [file dirname $fileselect(dir)]
  329.         return
  330.     }
  331.  
  332.     set path [file join $fileselect(dir) $fileselect(path)]
  333.  
  334.     if {![file exists $path]} {
  335.       set decision [tk_messageBox -icon question \
  336.         -message $labelMessages(unknown) -title $labelTitles(unknown)     \
  337.         -parent .fileselect -type yesno]
  338.       switch $decision {
  339.           yes {
  340.               file mkdir $path
  341.               set fileselect(path) $path
  342.               set fileselect(done) 1
  343.               return
  344.           }
  345.           no return
  346.       }
  347.     }
  348.     if {[file isdirectory $path]} {
  349.         set fileselect(done) 1
  350.         set fileselect(path) $path
  351.     }
  352.     return
  353. }
  354.  
  355. ###############################################################################
  356. # fileselectCancel
  357. #    Procedure to cancel the selection
  358. ##############################################################################
  359. proc fileselectCancel {} {
  360.     variable fileselect
  361.  
  362.     set fileselect(done) 1
  363.     set fileselect(path) {}
  364.  
  365.     return
  366. }
  367.  
  368. ###############################################################################
  369. # fileselectClick
  370. #    Select the clicked item in the directory list.
  371. #
  372. # Parameter
  373. #    y: point where the user clicked.
  374. ##############################################################################
  375. proc fileselectClick { y } {
  376.     variable fileselect
  377.  
  378.     set l .fileselect.lista.list
  379.     set fileselect(path) [$l get [$l nearest $Y]]
  380.     focus $fileselect(pathEnt)
  381.  
  382.     return
  383. }
  384.  
  385. ###############################################################################
  386. # fileselectTake
  387. #    Takes the selected item from the directory list and puts it in the
  388. #    path entry.
  389. ##############################################################################
  390. proc fileselectTake {} {
  391.     variable fileselect
  392.  
  393.     set l .fileselect.lista.list
  394.     set seleccion [$l curselection]
  395.     if {$seleccion!=""} {
  396.         set fileselect(path) [$l get $seleccion]
  397.     }
  398.     focus $fileselect(pathEnt)
  399.  
  400.     return
  401. }
  402.  
  403. ###############################################################################
  404. # fileselectTmp
  405. #    Invoked when the user doubleclicks on an item in the directory list,
  406. #    takes the directory and makes it the current one.
  407. ##############################################################################
  408. proc fileselectTmp {} {
  409.     variable fileselect
  410.  
  411.     fileselectTake
  412.     if {[string match \.\. $fileselect(path)] } {
  413.         fileselectList [file dirname $fileselect(dir)]
  414.     } else {
  415.         fileselectList [file join $fileselect(dir) $fileselect(path)]
  416.     }
  417.     set fileselect(path) ""
  418.  
  419.     return
  420. }
  421. }
  422.